      SUBROUTINE TSHUTL                                                 5663

c	include 'tcommon.for'
	%include tcommon.for

      EQUIVALENCE(ISHST,ISTSH)                                          5701
      DATA PRSHXD,ZFIND,NTTF/.01,.4,18/                                 5702
      PCT(A,B)=(A-B)/B*100.                                             5703
C     ...ISDH SHOWS WANTS. ISTSH SHOWS STATUS.                          5704
C     ...ISHD=1-9. EXPLORE STAR SYSTEM 1-9.                             5705
C     ...ISHD=99. RETURN TO E.                                          5706
C     ...ISHD=0. DO NOTHING.                                            5707
C     ...ISTSH=1-9. ON STAR SYSTEM 1-9.                                 5708
C     ...ISTSH=99. IN SPACE.                                            5709
C     ...ISTSH=0. ON E.                                                 5710
      IF(ISHD.EQ.99)GO TO 500                                           5711
C     ...EXPLORE NEW STAR SYSTEM.                                       5712
      IF(ISHST.EQ.ISHD)GO TO 999                                        5713
      IF(ISTSH.NE.0)GO TO 100                                           5714
      WRITE(*,1)                                                        5715
1     FORMAT(' SHUTTLECRAFT LAUNCHED')                                  5716
      SHX=XQE                                                           5717
      SHY=YQE                                                           5718
C     ...MOVE IT.                                                       5719
100   CALL GETBRG(SHDEG,SHX,STARS(ISHD,1),SHY,STARS(ISHD,2),VPX,VPY)    5720
      IF(ISTSH.EQ.99)GO TO 110                                          5721
      VPX=SQRT(VPX*VPX+VPY*VPY)/SHVX/100.-.01                           5722
      WRITE(*,101)VPX                                                   5723
101   FORMAT(' ARRIVAL IN ',F4.2,' STARDAYS')                           5724
110   ISTSH=99                                                          5725
      SHX=SHX+COSD(SHDEG)*SHVX                                          5726
      SHY=SHY+SIND(SHDEG)*SHVX                                          5727
C     ...CHECK IF ENTERING STAR SYSTEM.                                 5728
      IF(RANGE(SHX,STARS(ISHD,1),SHY,STARS(ISHD,2)).GT.RADSS)GO TO 999  5729
      ISHST=ISHD                                                        5730
      WRITE(*,2)ISHD                                                    5731
2     FORMAT(' STAR SYSTEM ',I2,' ENTERED AND EXPLORED')                5732
C     ...FINDS. DO NOT TELL UNTIL RETURN UNLESS DESTROYED.              5733
      IF(IFNDS(ISHD).NE.0)GO TO 300                                     5734
      IF(RAN(IZZ).GE.PRSHXD)GO TO 200                                   5735
155   WRITE(*,3)                                                        5736
3     FORMAT(' SHUTTLECRAFT LOST OR DESTROYED')                         5737
      ISHD=0                                                            5738
      ISHST=0                                                           5739
      JMSG=0                                                            5740
      DO 156 J=1,9                                                      5741
      IF(IFNDS(J).EQ.-1)GO TO 156                                       5742
      IFNDS(J)=0                                                        5743
      ISHSTR(J)=0                                                       5744
156   CONTINUE                                                          5745
      ISHNUM=ISHNUM-1                                                   5746
      GO TO 999                                                         5747
200   X=RAN(IZZ)                                                        5748
      DO 210 J=1,NTTF                                                   5749
      IF(X.LE.ZFIND+(J-1)*((1.-ZFIND)/NTTF))GO TO 220                   5750
210   CONTINUE                                                          5751
220   IFNDS(ISHD)=J                                                     5752
230   ISHST=ISHD                                                        5753
      ISHD=ISHSTR(2)                                                    5754
      IF(ISHD.LE.0.OR.STARS(ISHD,1).EQ.0.)ISHD=99                       5755
      DO 240 J=2,10                                                     5756
240   ISHSTR(J-1)=ISHSTR(J)                                             5757
      GO TO 999                                                         5758
300   WRITE(*,301)                                                      5759
301   FORMAT(' WE''VE BEEN HERE BEFORE, YOU DUMMY!')                    5760
      GO TO 230                                                         5761
C     ...RETURN TO E.                                                   5762
500   IF(ISHST.EQ.0)GO TO 996                                           5763
      IF(JMSG.NE.0)GO TO 502                                            5764
      JMSG=1                                                            5765
      DO 501 J=1,NSTARS                                                 5766
      IF(IFNDS(J).EQ.15)GO TO 503                                       5767
501   CONTINUE                                                          5768
      GO TO 502                                                         5769
503   WRITE(*,504)                                                      5770
504   FORMAT(' SHUTTLECRAFT TAKEN OVER BY DANGEROUS ALIENS. TYPE "1" TO 5771
     1DESTROY IT.')                                                     5772
      READ(*,506,ERR=503,END=4321)K                                     5773
506   FORMAT(I1)                                                        5774
      IF(K.EQ.1)GO TO 155                                               5775
502   DO 50201 I=1,10                                                   5776
50201 ISHSTR(I)=0                                                       5777
      CALL GETBRG(SHDEG,SHX,XQE,SHY,YQE,VPX,VPY)                        5778
      SHX=SHX+COSD(SHDEG)*SHVX                                          5779
C     ...CHECK FOR RETURN. PRINT FINDINGS.                              5780
      IF(ISHST.EQ.99)GO TO 505                                          5781
      VPX=SQRT(VPX*VPX+VPY*VPY)/SHVX/100.                               5782
      WRITE(*,101)VPX                                                   5783
      ISTSH=99                                                          5784
505   SHY=SHY+SIND(SHDEG)*SHVX                                          5785
      IF(RANGE(SHX,XQE,SHY,YQE).GE.RADES)GO TO 999                      5786
      WRITE(*,4)                                                        5787
4     FORMAT(' SHUTTLECRAFT RETURNED')                                  5788
      JJ=0                                                              5789
      DO 550 J=1,NSTARS                                                 5790
      IF(IFNDS(J).LE.1)GO TO 550                                        5791
      K=IFNDS(J)-1                                                      5792
      IFNDS(J)=-1                                                       5793
      GO TO (601,602,603,604,605,606,607,608,609,610,611,6115,612,613,615794
     14,615,616),K                                                      5795
C     ...DISEASE.                                                       5796
601   IF(IDSES.EQ.1)GO TO 550                                           5797
      WRITE(*,701)                                                      5798
701   FORMAT(' VIRULENT DISEASE RAMPAGING ON ENTERPRISE!')              5799
      IDSES=1                                                           5800
      VDSES=RAN(IZZ)*VDSESM                                             5801
      VSTRDS=RAN(IZZ)*.15+VSTRM                                         5802
      GO TO 555                                                         5803
C     ...WARP DRIVE ACCELERATION INCREASE.                              5804
602   IF(DVWP.GE.1.)GO TO 6025                                          5805
      XINC=DVWP+2.*DVWP*DVWP*RAN(IZZ)                                   5806
      GO TO 6016                                                        5807
6025  XINC=DVWP+.3*DVWP*RAN(IZZ)                                        5808
6016  IXRAT=PCT(XINC,DVWP)                                              5809
      IF(IXRAT.EQ.0)GO TO 550                                           5810
      WRITE(*,702)NAMD(1),IXRAT                                         5811
702   FORMAT(' ',A10,' ACCELERATION INCREASED ',I3,'%')                 5812
C     ...REVISE ENERGY USAGE TO COMPENSATE FOR INCREASED ACCELERATION.  5813
      VPY=IXRAT/100.                                                    5814
      VPX=EWRP                                                          5815
      EWRP=DVWP*DVWP*EWRP/(XINC*XINC)                                   5816
      DVWP=XINC                                                         5817
      IXRAT=-PCT(VPX,EWRP0)                                             5818
      EWRP0=EWRP/(1.-FLOAT(IXRAT)/100.)                                 5819
C     ...ALSO INCREMENT DEG CHANGE/SM, ALTHOUGH NOT BY SO MUCH.         5820
      DGWP=DGWP+RAN(IZZ)*DGWP/3.                                        5821
      IF(DGWP.GT.90.)DGWP=90.                                           5822
      GO TO 555                                                         5823
C     ...WAPR DRIVE EFFICIENCY.                                         5824
603   XINC=EWRP-1.7*SQRT(EWRP)*RAN(IZZ)                                 5825
      IXRAT=-PCT(XINC,EWRP)                                             5826
      IF(IXRAT.EQ.0)GO TO 550                                           5827
      WRITE(*,703)NAMD(1),IXRAT                                         5828
703   FORMAT(1X,A10,' EFFICIENCY INCREASED BY ',I3,'%')                 5829
      EWRP=XINC                                                         5830
      EVENU=EVENU-IXRAT/100.*EVENU                                      5831
      GO TO 555                                                         5832
C     ...PHASER IMPROVEMENT.                                            5833
604   XINC=DISTPE+.5*SQRT(DISTPE)*RAN(IZZ)                              5834
      IXRAT=PCT(XINC,DISTPE)                                            5835
      IF(IXRAT.EQ.0)GO TO 550                                           5836
      WRITE(*,704)NAMD(3),IXRAT                                         5837
704   FORMAT(1X,A10,' EFFECTIVENESS INCREASED BY ',I3,'%')              5838
      DISTPE=XINC                                                       5839
      GO TO 555                                                         5840
C     ...TORP V INCREASE.                                               5841
605   ETVEL=ETVEL+(.9-ETVEL)/5.                                         5842
      WRITE(*,705)NAMD(4),ETVEL                                         5843
705   FORMAT(1X,A10,' VELOCITY INCREASED TO ',F5.3)                     5844
      GO TO 555                                                         5845
C     ...TORP RATE OF FIRE.                                             5846
606   IETOFT=IETOFT+1                                                   5847
      WRITE(*,706)NAMD(4),IETOFT                                        5848
706   FORMAT(1X,A10,' RATE NOW ',I2,' PER STAR-MINUTE')                 5849
      GO TO 555                                                         5850
607   XINC=DISTGT+.5*SQRT(DISTGT)*RAN(IZZ)                              5851
      IXRAT=PCT(XINC,DISTGT)                                            5852
      IF(IXRAT.EQ.0)GO TO 550                                           5853
      WRITE(*,704)NAMD(5),IXRAT                                         5854
      DISTGT=XINC                                                       5855
      DISTKR=DISTKR+IXRAT/100.*DISTKR                                   5856
      GO TO 555                                                         5857
608   XINC=CODDS+CODDS*CODDS*5.*RAN(IZZ)                                5858
      IXRAT=PCT(XINC,CODDS)                                             5859
      IF(IXRAT.EQ.0)GO TO 550                                           5860
      WRITE(*,708)IXRAT                                                 5861
708   FORMAT(' TROOP FIGHTING EFFECTIVENESS VS KLINGONS INCREASED BY ',I5862
     13,'%')                                                            5863
      CODDS=XINC                                                        5864
      GO TO 555                                                         5865
609   XINC=EODDS+EODDS*EODDS*2.5*RAN(IZZ)                               5866
      IXRAT=PCT(XINC,EODDS)                                             5867
      IF(IXRAT.EQ.0)GO TO 550                                           5868
      WRITE(*,709)IXRAT                                                 5869
709   FORMAT(' TROOP FIGHTING EFFECTIVENESS VS ROMULANS INCREASED BY ',I5870
     13,'%')                                                            5871
      EODDS=XINC                                                        5872
      GO TO 555                                                         5873
C     ...TRANSPORTERS.                                                  5874
610   JDAMRP =FLOAT(IDAMRP)+2.*SQRT(FLOAT(IDAMRP))*RAN(IZZ)             5875
      IF(JDAMRP.EQ.IDAMRP)GO TO 550                                     5876
      IDAMRP=JDAMRP                                                     5877
      WRITE(*,706) NAMD(8),IDAMRP                                       5878
      GO TO 555                                                         5879
C     ...COMMUNICATIONS.                                                5880
611   XINC=PJAM-2.*PJAM*(PJAM)*RAN(IZZ)                                 5881
      IXRAT=PCT(-XINC,-PJAM)                                            5882
      IXRAT=-IXRAT                                                      5883
      IF(IXRAT.EQ.0)GO TO 550                                           5884
      WRITE(*,710)NAMD(9),IXRAT                                         5885
710   FORMAT(1X,A10,' INTERCEPTION PROBABILITY REDUCED BY ',I3,'%')     5886
      PJAM=XINC                                                         5887
      GO TO 555                                                         5888
C     ...SHIELDS IMPROVEMENT.                                           5889
6115  XINC=SHLDF+RAN(IZZ)*.2*SHLDF                                      5890
      IXRAT=PCT(XINC,SHLDF)                                             5891
      IF(IXRAT.EQ.0)GO TO 550                                           5892
      WRITE(*,6112)IXRAT                                                5893
6112  FORMAT(' SHIELDS IMPROVED BY ',I3 ,'%')                           5894
      SHLDF=XINC                                                        5895
      GO TO 555                                                         5896
C     ...ALIEN FORCE-HOSTILE                                            5897
612   IF (IALSS.NE.0)GO TO 550                                          5898
      IXRAT=RAN(IZZ)*40.+10.                                            5899
      XINC=ENERGY/IXRAT/100.                                            5900
      WRITE(*,712)J,IXRAT,XINC                                          5901
712   FORMAT(' ALIEN BEINGS FROM STAR SYSTEM ',I1,' DRAINING'/      ' EN5902
     1TERPRISE ENERGY BANKS AT THE RATE OF ',I3,' UNITS/STARMINUTE'/    5903
     1  ' ZERO ENERGY LEVEL IN ',F6.2,' STARDAYS!!')                    5904
      ALEDR=IXRAT                                                       5905
      IALIC=ICE                                                         5906
      IALJC=JCE                                                         5907
      IALSS=J                                                           5908
      GO TO 555                                                         5909
C     ...ENERGY FORMS                                                   5910
613   IF(NDRA.EQ.1)GO TO 550                                            5911
      IF(IDMG(1).NE.0)GO TO 550                                         5912
      WRITE(*,713)                                                      5913
713   FORMAT(' SEMI-SENTIENT ENERGY FORMS INVADING ENTERPRISE COMPUTER B5914
     1ANKS!'/      ' ENTERPRISE WARP DRIVE ENGINES UNDER ALIEN CONTROL!!5915
     1')                                                                5916
      NDRA=1                                                            5917
      DSP=RAN(IZZ)+1.                                                   5918
      JMSG=0                                                            5919
      DDEG=RAN(IZZ)*360.                                                5920
      GO TO 555                                                         5921
C     ...TROOP REINFORCEMENTS.                                          5922
614   IXRAT=RAN(IZZ)*NTROPS+1.                                          5923
      WRITE(*,714)IXRAT,J                                               5924
714   FORMAT(1X,I4,' ANDROID TROOP REINFORCEMENTS FROM FRIENDLY CIVILIZA5925
     1TION'/      ' ON STAR SYSTEM ',I1)                                5926
      ITRMEN(1)=ITRMEN(1)+IXRAT                                         5927
      GO TO 555                                                         5928
C     ...IMPROVED TRANSPORTER ENERGY USAGE.                             5929
615   XINC=TRNRGY-RAN(IZZ)*TRNRGY*TRNRGY*.5                             5930
      IXRAT=-PCT(XINC,TRNRGY)                                           5931
      IF(IXRAT.LE.0)GO TO 500                                           5932
      WRITE(*,703)NAMD(8),IXRAT                                         5933
      TRNRGY=XINC                                                       5934
      GO TO 555                                                         5935
C     ...MICROTRIBBLES.                                                 5936
616   SDAYS=RAN(IZZ)+1.                                                 5937
      WRITE(*,716)                                                      5938
716   FORMAT(' MICRO-TRIBBLES MULTIPLYING OUT OF CONTROL IN COMPUTER BAN5939
     1KS!!')                                                            5940
      IDMG(10)=IDMG(10)+SDAYS*100.                                      5941
      GO TO 555                                                         5942
555   JJ=1                                                              5943
550   CONTINUE                                                          5944
      IF(JJ.EQ.1)GO TO 800                                              5945
      WRITE(*,575)                                                      5946
575   FORMAT(' NOTHING OF VALUE FOUND THIS EXPLORATION')                5947
800   ISTSH=0                                                           5948
      ISHD=0                                                            5949
999   RETURN                                                            5950
4321  STOP                                                              5951
C     ...RETURN NOT POSSIBLE.                                           5952
996   WRITE(*,995)                                                      5953
995   FORMAT(' RETURN NOT POSSIBLE')                                    5954
      GO TO 999                                                         5955
      END                                                               5956
